home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Gold Medal Software 3
/
Gold Medal Software - Volume 3 (Gold Medal) (1994).iso
/
prog
/
anidial.arj
/
ANITEST.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1994-01-23
|
21KB
|
704 lines
{
Demo program for the Dialog Box Animator.
By Tim Schempp
January, 1994
CompuSevre Id 71224,455
This program will give you a pretty good idea of what the Dialog Animator
can do to spice up your programs. This sample program may seem a little
long and involved, but it was necessary to fully demonstrate the unit.
program SIMPLE.PAS will give you a simpler more readable example of how to
use this unit. Read the documentation for a full explanation of the
units features.
Please feel free to use the Dialog Box Animator in any of you programs,
and pass it on to friends. I will get a big kick out of seeing it used in
somebody elses program.
}
program AniTest;
uses Objects,Drivers,Views,App,Menus,Dialogs,Editors,MsgBox,AnimateDialog;
const cmBounceBox = 1001;
cmBounceDH = 1002;
cmBounceDV = 1003;
cmBounceDA = 1004;
cmAbout = 1005;
cmDataEntry = 1006;
cmSubView = 1007;
cmExitNow = 1008;
cmSlower = 1009;
cmWinDialog = 1010;
cmAniToggle = 1011;
type
TTestApp=object(TApplication)
PAbout,
PBounceBox,
PDataEntryBox,
PSubView,
PWinDialog,
PExitDialog:PAnimateDialog;
AnimationOff:Boolean;
constructor Init;
procedure HandleEvent(var Event:TEvent); virtual;
procedure GetEvent(var Event:TEvent); virtual;
procedure InitStatusLine; virtual;
procedure Idle; virtual;
procedure About;
procedure BounceBox;
procedure DataEntry;
procedure SubView;
procedure WinDialog;
procedure MakeWindows;
procedure ExitDialog;
end;
{******}
constructor TTestApp.Init;
begin
inherited Init;
AnimationOff:=False;
end;
{******}
procedure TTestApp.HandleEvent(var Event:TEvent);
begin
inherited HandleEvent(Event);
case Event.What of
evCommand: case Event.Command of
cmBounceBox : begin BounceBox;
ClearEvent(Event); end;
cmAbout : begin About;
ClearEvent(Event); end;
cmDataEntry : begin DataEntry;
ClearEvent(Event); end;
cmWinDialog : begin WinDialog;
ClearEvent(Event); end;
cmExitNow : begin ExitDialog;
ClearEvent(Event); end;
cmAniToggle : AnimationOff:=not AnimationOff;
end; {case}
end; {case}
end;
{******}
procedure TTestApp.GetEvent(var Event:TEvent);
var R:TRect;
begin
inherited GetEvent(Event);
case Event.What of
evCommand : case Event.Command of
cmBounceDV : begin
with PAniItem(PBounceBox^.AniList^.At(0))^ do
begin
XStep:=0; YStep:=1;
Param:=AniBounceBack;
end; {with}
ClearEvent(Event);
end;
cmBounceDH : begin
with PAniItem(PBounceBox^.AniList^.At(0))^ do
begin
XStep:=2; YStep:=0;
Param:=AniBounceBack;
end; {with}
ClearEvent(Event);
end;
cmBounceDA : begin
with PAniItem(PBounceBox^.AniList^.At(0))^ do
begin
XStep:=2; YStep:=1;
Param:=AniBounceAround;
end; {with}
ClearEvent(Event);
end;
cmSubView : begin SubView;
ClearEvent(Event); end;
cmAniToggle : AnimationOff:=not AnimationOff;
cmSlower : with PAniItem(PExitDialog^.AniList^.At(0))^ do
if DelayTime<=50 then Inc(DelayTime,1);
end; {case}
end; {case}
end;
{******}
procedure TTestApp.InitStatusLine;
var R:TRect;
begin
GetExtent(R);
R.A.Y:=R.B.Y-1;
StatusLine:=New(PStatusLine,Init(r,
NewStatusDef(0, $ffff,
NewStatusKey('~Alt-X~ Exit',kbAltX,cmExitNow,
NewStatusKey('~F2~ About',kbF2,cmAbout,
NewStatusKey('~F3~ Bounce',kbF3,cmBounceBox,
NewStatusKey('~F4~ Entries',kbF4,cmDataEntry,
NewStatusKey('~F5~ Windows',kbF5,cmWinDialog,
NewStatusKey('~F9~ Toggle Animation',kbF9,cmAniToggle,
nil)))))),
nil)
));
end;
{******}
procedure TTestApp.Idle;
begin
inherited Idle;
if not AnimationOff then
begin
if PAbout<>nil then PAbout^.UpDate;
if PBounceBox<>nil then PBounceBox^.UpDate;
if PDataEntryBox<>nil then PDataEntryBox^.UpDate;
if PSubView<>nil then PSubView^.UpDate;
if PWinDialog<>nil then PWinDialog^.UpDate;
if PExitDialog<>nil then PExitDialog^.UpDate;
end; {if}
end;
{******}
procedure TTestApp.About;
var R:TRect;
Boundry:TRect;
AView:PView;
AniItem:PAniItem;
begin
R.Assign(20,2,60,20);
PAbout:=New(PAnimateDialog,Init(R,'About the animator...'));
with PAbout^ do
begin
GetExtent(Boundry);
Inc(Boundry.B.X,-1);
Inc(Boundry.B.Y,-1);
Inc(Boundry.A.X,1);
Inc(Boundry.A.Y,1);
R.Assign(10,1,29,2);
AView:=New(PStaticText,Init(R,'THE DIALOG ANIMATOR'));
Insert(AView);
R.Assign(10,1,29,6);
AniItem:=New(PAniItem,Init(AView,R,AniBounceBack,15,0,1));
AniList^.Insert(AniItem);
R.Assign(1,7,15,8);
AView:=New(PStaticText,Init(R,'By Tim Schempp'));
Insert(AView);
R.Assign(Boundry.A.X,7,Boundry.B.X,8);
AniItem:=New(PAniItem,Init(AView,R,AniBounceBack,10,1,0));
AniList^.Insert(AniItem);
R.Assign(10,9,30,15);
AView:=New(PStaticText,Init(R,''));
AView^.Options:=AView^.Options or ofFramed;
Insert(AView);
R.Assign(10,9,23,11);
AView:=New(PStaticText,Init(R,'CompuServe ID'+Chr(13)+' 71224,455'));
Insert(AView);
R.Assign(10,9,30,15);
AniItem:=New(PAniItem,Init(AView,R,AniBounceAround,15,1,1));
AniList^.Insert(AniItem);
R.Assign(Boundry.B.X-13,16,Boundry.B.X,17);
AView:=New(PStaticText,Init(R,'January, 1994'));
Insert(AView);
R.Assign(Boundry.A.X,16,Boundry.B.X,17);
AniItem:=New(PAniItem,Init(AView,R,AniBounceBack,15,-1,0));
AniList^.Insert(AniItem);
R.Assign(25,15,35,17);
AView:=New(PButton,Init(R,'~O~k',cmOk,bfDefault));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,Boundry,AniBounceAround,11,-3,-1));
AniList^.Insert(AniItem);
end; {with}
DeskTop^.ExecView(PAbout);
Dispose(PAbout,Done);
PAbout:=nil; {Don't forget to do this!!!}
R.Assign(20,3,60,17);
PAbout:=New(PAnimateDialog,Init(R,'Please Note'));
with PAbout^ do
begin
GetExtent(Boundry);
Inc(Boundry.B.X,-1);
Inc(Boundry.B.Y,-1);
Inc(Boundry.A.X,1);
Inc(Boundry.A.Y,1);
R.Assign(5,1,35,2);
AView:=New(PStaticText,Init(R,'If you like this program and'));
Insert(AView);
R.Assign(5,1,35,11);
AniItem:=New(PAniItem,Init(AView,R,AniNone,25,0,1));
AniList^.Insert(AniItem);
R.Assign(5,2,35,3);
AView:=New(PStaticText,Init(R,'found it useful'));
Insert(AView);
R.Assign(5,1,35,11);
AniItem:=New(PAniItem,Init(AView,R,AniNone,25,0,1));
AniList^.Insert(AniItem);
R.Assign(5,3,35,4);
AView:=New(PStaticText,Init(R,'(or at least cute)'));
Insert(AView);
R.Assign(5,1,35,11);
AniItem:=New(PAniItem,Init(AView,R,AniNone,25,0,1));
AniList^.Insert(AniItem);
R.Assign(5,4,35,5);
AView:=New(PStaticText,Init(R,'send me some CompuServe EMail!'));
Insert(AView);
R.Assign(5,1,35,11);
AniItem:=New(PAniItem,Init(AView,R,AniNone,25,0,1));
AniList^.Insert(AniItem);
R.Assign(5,5,35,6);
AView:=New(PStaticText,Init(R,'Tim Schempp 71224,455'));
Insert(AView);
R.Assign(5,1,35,11);
AniItem:=New(PAniItem,Init(AView,R,AniNone,25,0,1));
AniList^.Insert(AniItem);
R.Assign(1,11,11,13);
AView:=New(PButton,Init(R,'~O~k',cmOk,bfDefault));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,Boundry,AniBounceBack,10,-1,0));
AniList^.Insert(AniItem);
end; {with}
DeskTop^.ExecView(PAbout);
Dispose(PAbout,Done);
PAbout:=nil; {Don't forget to do this!!!}
end;
{******}
procedure TTestApp.BounceBox;
var R:TRect;
Boundry:TRect;
AView:PView;
AniItem:PAniItem;
begin
R.Assign(0,0,49,13);
PBounceBox:=New(PAnimateDialog,Init(R,'Bouncing Dialog'));
with PBounceBox^ do
begin
DeskTop^.GetExtent(Boundry);
Inc(Boundry.A.X,1);
Inc(Boundry.B.X,-1); Inc(Boundry.B.Y,-1);
AniItem:=New(PAniItem,Init(PBounceBox,Boundry,AniBounceAround,10,1,1));
AniList^.Insert(AniItem);
R.Assign(10,2,39,3);
AView:=New(PStaticText,Init(R,'This is a Bouncing Dialog Box'));
Insert(AView);
R.Assign(15,4,34,7);
AView := New(PRadioButtons, Init(R,
NewSItem('~I~ Like it!',
NewSItem('I ~D~islike it!',
NewSItem('I~t~''s annoying!', nil)))));
Insert(AView);
R.Assign(1,8,15,10);
AView:=New(PButton,Init(R,'~H~orizontal',cmBounceDH,bfNormal));
Insert(AView);
R.Assign(17,8,31,10);
AView:=New(PButton,Init(R,'~V~erticle',cmBounceDV,bfNormal));
Insert(AView);
R.Assign(33,8,47,10);
AView:=New(PButton,Init(R,'~A~round',cmBounceDA,bfNormal));
Insert(AView);
R.Assign(17,10,31,12);
AView:=New(PButton,Init(R,'~O~k',cmOk,bfDefault));
Insert(AView);
end; {with}
DeskTop^.ExecView(PBounceBox);
Dispose(PBounceBox,Done);
PBounceBox:=nil; {Don't forget to do this!!!}
end;
{******}
procedure TTestApp.DataEntry;
var R,R2:TRect;
Boundry:TRect;
AView,View2:PView;
AniItem:PAniItem;
OrigState:Boolean;
begin
OrigState:=AnimationOff;
AnimationOff:=True;
R.Assign(12, 0, 67, 23);
PDataEntryBox:=New(PAnimateDialog,Init(R,'Data Entry'));
with PDataEntryBox^ do
begin
GetExtent(Boundry);
Inc(Boundry.A.X,1); Inc(Boundry.A.Y,1);
Inc(Boundry.B.X,-1); Inc(Boundry.B.Y,-1);
R.Assign(4, 2, 52, 3);
AView := New(PStaticText, Init(R, 'This may look like a common data entr'+
'y screen...'));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,Boundry,AniBounceBack,12,-1,0));
AniList^.Insert(AniItem);
R2.Assign(4,4,50,7);
R.Assign(15, 4, 50, 5);
AView:= New(PInputLine, Init(R, 40));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,R2,AniNone,125,0,2));
AniList^.Insert(AniItem);
R.Assign(4, 4, 12, 5);
View2:=New(PLabel, Init(R, '~N~ame', AView));
Insert(View2);
AniItem:=New(PAniItem,Init(View2,R2,AniNone,125,0,2));
AniList^.Insert(AniItem);
R.Assign(15, 6, 50, 7);
AView := New(PInputLine, Init(R, 40));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,R2,AniNone,125,0,2));
AniList^.Insert(AniItem);
R.Assign(4, 6, 12, 7);
View2:=New(PLabel, Init(R, '~A~ddress', AView));
Insert(View2);
AniItem:=New(PAniItem,Init(View2,R2,AniNone,125,0,2));
AniList^.Insert(AniItem);
R2.Assign(4,8,50,10);
R.Assign(15, 8, 27, 9);
AView := New(PInputLine, Init(R, 15));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,R2,AniBounceBack,30,0,1));
AniList^.Insert(AniItem);
R.Assign(4, 8, 12, 9);
View2:=New(PLabel, Init(R, 'P~h~one #', AView));
Insert(View2);
AniItem:=New(PAniItem,Init(View2,R2,AniBounceBack,30,0,1));
AniList^.Insert(AniItem);
R.Assign(38, 8, 50, 10);
AView := New(PRadioButtons, Init(R,
NewSItem('Male',
NewSItem('Female', Nil))));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,R2,AniBounceBack,30,0,1));
AniList^.Insert(AniItem);
R.Assign(33, 8, 37, 9);
View2:=New(PLabel, Init(R, '~S~ex', AView));
Insert(View2);
AniItem:=New(PAniItem,Init(View2,R2,AniBounceBack,30,0,1));
AniList^.Insert(AniItem);
R.Assign(15, 11, 46, 14);
AView := New(PMemo, Init(R, Nil, Nil, Nil, 255));
Insert(AView);
R2.Assign(15,11,50,14);
AniItem:=New(PAniItem,Init(AView,R2,AniBounceBack,10,1,0));
AniList^.Insert(AniItem);
R.Assign(3, 11, 10, 12);
View2:=New(PLabel, Init(R, '~R~emark', AView));
Insert(View2);
R2.Assign(3,11,10,14);
AniItem:=New(PAniItem,Init(View2,R2,AniBounceBack,20,0,1));
AniList^.Insert(AniItem);
R.Assign(16, 15, 45, 18);
AView := New(PCheckboxes, Init(R,
NewSItem('Please Send Information',
NewSItem('Please Call Me',
NewSItem('Don''t Contact Me', Nil)))));
Insert(AView);
R.Assign(1,15,55,22);
AniItem:=New(PAniItem,Init(AView,R,AniBounceAround,10,-1,-1));
AniList^.Insert(AniItem);
R.Assign(4, 19, 14, 21);
AView := New(PButton, Init(R, 'O~k~', cmOK, bfDefault));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,Boundry,AniNone,15,0,1));
AniList^.Insert(AniItem);
R.Assign(21, 19, 31, 21);
AView := New(PButton, Init(R, '~C~ancel', cmCancel, bfNormal));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,Boundry,AniNone,15,0,1));
AniList^.Insert(AniItem);
R.Assign(39, 19, 50, 21);
AView := New(PButton, Init(R, '~P~ush Me', cmSubView, bfNormal));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,Boundry,AniNone,15,0,1));
AniList^.Insert(AniItem);
SelectNext(False);
end; {with}
DeskTop^.ExecView(PDataEntryBox);
Dispose(PDataEntryBox,Done);
PDataEntryBox:=nil; {Don't forget to do this!!!}
AnimationOff:=OrigState;
end;
{******}
procedure TTestApp.SubView;
var R:TRect;
Boundry:TRect;
AView:PView;
AniItem:PAniItem;
begin
R.Assign(20, 4, 61, 17);
PSubView:=New(PAnimateDialog,Init(R,'Foreground/Background Animation'));
with PSubView^ do
begin
GetExtent(Boundry);
Inc(Boundry.A.X,1); Inc(Boundry.A.Y,1);
Inc(Boundry.B.X,-1); Inc(Boundry.B.Y,-1);
R.Assign(12, 2, 28, 3);
AView := New(PStaticText, Init(R, 'Choose a Button!'));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,Boundry,AniBounceAround,2,2,1));
AniList^.Insert(AniItem);
R.Assign(20, 1, 21, 2);
AView := New(PStaticText, Init(R, '*'));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,Boundry,AniBounceAround,2,2,1));
AniList^.Insert(AniItem);
R.Assign(20, 11, 21, 12);
AView := New(PStaticText, Init(R, '*'));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,Boundry,AniBounceAround,2,2,1));
AniList^.Insert(AniItem);
R.Assign(12, 9, 28, 11);
AView := New(PButton, Init(R, '~D~one', cmOk, bfDefault));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,Boundry,AniBounceAround,2,-1,1));
AniList^.Insert(AniItem);
R.Assign(10, 4, 30, 8);
AView := New(PButton, Init(R, '~T~oggle Animation', cmAniToggle, bfNormal));
Insert(AView);
SelectNext(False);
end; {with}
DeskTop^.ExecView(PSubView);
Dispose(PSubView,Done);
PSubView:=nil; {Don't forget to do this!!!}
end;
{******}
procedure TTestApp.WinDialog;
var R:TRect;
Boundry:TRect;
AView:PView;
Window:PWindow;
AniItem:PAniItem;
Counter:Integer;
{*}
procedure AddToList(P:PView); far;
var AniItem:PAniItem;
begin
AniItem:=New(PAniItem,Init(P,Boundry,AniBounceAround,7,Random(5)-2,Random(5)-2));
PWinDialog^.AniList^.Insert(AniItem);
end;
{*}
begin
Randomize;
MakeWindows; {Add some Windows to the DeskTop}
MessageBox('First we''ll insert some windows into the DeskTop.'
,nil,mfOkButton+mfInformation);
R.Assign(20, 3, 61, 19);
PWinDialog:=New(PAnimateDialog,Init(R,'DeskTop Animation'));
PWinDialog^.UpDateOn:=False;
PWinDialog^.SpecialKey:=kbAltA;
{Why not capture the whole desktop?}
DeskTop^.GetExtent(Boundry);
Inc(Boundry.A.X,1); Inc(Boundry.A.Y,1);
Inc(Boundry.B.X,-1); Inc(Boundry.B.Y,-1);
DeskTop^.ForEach(@AddToList);
with PWinDialog^ do
begin
GetExtent(Boundry);
Inc(Boundry.A.X,1); Inc(Boundry.A.Y,1);
Inc(Boundry.B.X,-1); Inc(Boundry.B.Y,-1);
R.Assign(4, 2, 38, 10);
AView := New(PStaticText, Init(R, 'In this example, the whole DeskTop has'+
' been captured with a DeskTop^.ForEach procedure. Although'+
' F9 Toggles the Global Dialog'+
' Animation, each Dialog Box can have its own Hot Key.'+
' Press Alt-A or Double Click on the "***" below to get'+
' this one started.'));
Insert(AView);
R.Assign(19, 11, 22, 12);
AView := New(PStaticText, Init(R, '***'));
Insert(AView);
AniItem:=New(PAniItem,Init(AView,Boundry,AniBounceBack,5,1,0));
AniList^.Insert(AniItem);
PWinDialog^.SpecialView:=AView; {Now the view activates the Dialog!}
R.Assign(10,13, 30, 15);
AView := New(PButton, Init(R, '~D~one', cmOk, bfDefault));
Insert(AView);
end; {with}
DeskTop^.ExecView(PWinDialog);
PWinDialog^.RestoreViews;
R.Assign(20,6,60,16);
MessageBoxRect(R,'By calling TAnimateDialog''s RestoreViews (before '
+'Disposing of it!) the Views will be restored to '
+' thier starting positions!'
,nil,mfOkButton+mfInformation);
Dispose(PWinDialog,Done);
PWinDialog:=nil; {Don't forget to do this!!!}
repeat until Message(DeskTop^.TopView,evCommand,cmClose,nil)=nil;
end;
{******}
procedure TTestApp.MakeWindows;
var P:PWindow;
R:TRect;
AniItem:PAniItem;
A,B:Integer;
begin
R.Assign(1,1,38,10);
P:=New(PWindow,Init(R,'Top Left Window',wnNoNumber));
DeskTop^.Insert(P);
R.Assign(40,1,78,10);
P:=New(PWindow,Init(R,'Top Right Window',wnNoNumber));
DeskTop^.Insert(P);
R.Assign(1,12,38,21);
P:=New(PWindow,Init(R,'Bottom Left Window',wnNoNumber));
DeskTop^.Insert(P);
R.Assign(40,12,78,21);
P:=New(PWindow,Init(R,'Bottom Right Window',wnNoNumber));
DeskTop^.Insert(P);
end;
{******}
procedure TTestApp.ExitDialog;
var R:TRect;
Boundry:TRect;
AView:PView;
AniItem:PAniItem;
begin
R.Assign(20, 4, 60, 20);
PExitDialog:=New(PAnimateDialog,Init(R,'Exit Dialog'));
with PExitDialog^ do
begin
R.Assign(4, 2, 38, 3);
AView := New(PStaticText, Init(R, 'To Exit, Click the Exit Button...'));
Insert(AView);
R.Assign(8, 3, 35, 4);
AView := New(PStaticText, Init(R, 'Or cheat and press Enter'));
Insert(AView);
R.Assign(5, 5, 15, 7);
AView := New(PButton, Init(R, '~C~ancel', cmCancel, bfNormal));
Insert(AView);
R.Assign(25, 5, 35, 7);
AView := New(PButton, Init(R, '~S~lower', cmSlower, bfNormal));
Insert(AView);
R.Assign(15, 7, 25, 9);
AView := New(PButton, Init(R, '~E~xit', cmOk, bfDefault));
Insert(AView);
R.Assign(1,7,39,15);
AniItem:=New(PAniItem,Init(AView,R,AniBounceAround,0,1,1));
AniList^.Insert(AniItem);
end; {with}
if DeskTop^.ExecView(PExitDialog)=cmOk
then Message(@Self,evCommand,cmQuit,nil);
Dispose(PExitDialog,Done);
PExitDialog:=nil; {Don't forget to do this!!!}
end;
{******}
var TestApp:TTestApp;
begin
TestApp.Init;
TestApp.Run;
TestApp.Done;
end.